COMMENT ⊗   VALID 00002 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002		DIMENSION II(1024),JJ(1024),KK(1024),LL(1024),KP(5),NN(4096)
C00017 ENDMK
C⊗;
	DIMENSION II(1024),JJ(1024),KK(1024),LL(1024),KP(5),NN(4096)
	1,A(384),B(384),IB(2048)
	COMMON KP,NP,NN,JF
	IMP(I)=IABS(NN(I)/100000000)
1	JE=0
	MN=0
	IP=-1
	MO=0
	NZ=10
	IM=0
	JF=0
	IS=-1
	NF=0
	LF=1
	CALL DPYCLR
	CALL TYPLOC(-350,-511)
	DO 407 I=1,4
407	KP(I)='     '
	CALL DPYSET(4,LL,1000)
	CALL DPYSET(3,KK,1000)
	CALL DPYSET(2,JJ,1000)
	CALL DPYSET(1,II,1000)
	MN=0
2	TYPE 5
5	FORMAT(' TYPE:<CR>;TO DRAW NEW PICTURE.'/
	1' OR TYPE IN NAME TO USE OLD PICTURE.'/)
	ACCEPT 3,NAM
3	FORMAT(A5)
	IF(NAM.EQ.'     ')GO TO 140
   	IF(.NOT.LOOKD(NAM))GO TO 2
515	CALL IFILE(1,NAM)
	READ(1)LE,(NN(K),K=MN+1,MN+LE)
	MN=MN+LE
	IP=-1
	IF(MO.NE.'P')GO TO 517
	MO=100000000
	DO 518 K=MN-LE+1,MN
	MP=1
	IF(NN(K))MP=-1
	NN(K)=IABS(NN(K))
518	NN(K)=MP*(NP*MO+(MOD(NN(K),MO)))
	GO TO 503
517	DO 388 K=1,MN
	NP=MOD(IMP(K),10)
	CALL SETPOG(NP)
	CALL INXY(NX,NY,K)
	MP=1
	IF(NN(K))MP=-1
388	CALL IPEN(NX,NY,MP,NZ)
   	DO 193 I=1,4
	KP(I)='VIS  '
193	CALL DPYOUT(I)
	CALL SETPOG(1)
140	NP=1
	CALL IPOG(NZ)

211	NS=0
120	LV=0
144	CALL SETCUR(NX,NY,LV)
	IF(NS)TYPE 6
6	FORMAT(' :'$)
	IF(JF.GT.0)TYPE 634
634	FORMAT(' O'$)
	ACCEPT 103,M,N
103	FORMAT(2A1)
	LX=NX
	LY=NY
	CALL RDCUR(NX,NY)
	IF(NC)GO TO 191
	IF(M.NE.' ')GO TO 11
308	IF(LV.NE.0)GO TO 192
301	CALL IPAK(NX,NY,MN,1,NZ)
	LV=1
	GO TO 144
192 	CALL IPAK(NX,NY,MN,-1,NZ)
341	N=NP
278	CALL DPYOUT(N)
	KP(N)='VIS  '
360	IF(IP)CALL IPOG(NZ)
260	IF(NS)GO TO 144
	GO TO 120

11	IF(M.EQ.':')GO TO 261
	IF(M.EQ.'.')GO TO 303
	IF(M.EQ.'W')GO TO 380
  	IF(M.EQ.'H')GO TO 306
	IF(M.EQ.'V')GO TO 307
	IF(M.EQ.'B')GO TO 105
  	IF(M.EQ.'C')GO TO 150
	IF(M.EQ.'+')GO TO 500
	IF(M.EQ.'-')GO TO 501
	IF(M.EQ.'*')GO TO 502
	IF(M.EQ.'J')GO TO 608
	IF(M.EQ.'O')GO TO 630
	IF(M.EQ.'A')GO TO 510
	IF(M.EQ.'E')GO TO 425
	IF(M.EQ.'G')GO TO 799
	IF(M.EQ.'(')GO TO 431
	IF(M.EQ.')')GO TO 432
  	IF(M.EQ.'I'.OR.M.EQ.'S')GO TO 230
	IF(M.EQ.'X')GO TO 104
	IF(M.EQ.'Z')GO TO 580
	IF(M.EQ.'F')GO TO 601
	IF(M.NE.'P')GO TO 260
	IP=-1
	IF(N.EQ.'I')GO TO 258
	IF(N.EQ.'D')GO TO 340
	IF(N.NE.' ')GO TO 231
259	NP=NP+1
	IF(NP.GT.4)NP=1
251	CALL SETPOG(NP)
	GO TO 503
630	IF(JF.GT.0)GO TO 701
	REREAD 710,M,JF
710	FORMAT(A1,I2)
	IF(JF.LT.1.OR.JF.GT.19.OR.JF.EQ.10)JF=1
	GO TO 261
701	JF=0
	GO TO 211
303	IF(LV.EQ.0)GO TO 301
	CALL IPAK(NX,NY,MN,-1,NZ)
333	KP(NP)='VIS  '
	IF(IP)CALL IPOG(NZ)
	CALL DPYOUT(NP)
	NX=LX
	NY=LY
	IF(.NOT.NC)GO TO 301
	NC=0
	GO TO 211
601	IT=0
702	IT=IT+1
	IF(IT.GT.19)GO TO 708
	IF(IT.EQ.10)IT=11
	I=0
	K=0
602	I=I+1
	IF(I.GT.MN)GO TO 660
606	IF(MOD(IMP(I),10).NE.NP)GO TO 602
	IF(IMP(I)/10.NE.IT)GO TO 602
	K=K+1
	CALL INXY(N,M,I)
	IF(IT.GT.10)CALL INXY(M,N,I)
	A(K)=N*NZ/10
	B(K)=M*NZ/10
	IB(K)=3
	IF(NN(I))IB(K)=2
	I=I+1
	IF(I.LE.MN)GO TO 606
660	IF(K.LT.3)GO TO 702
	IB(1)=K
	JI=IT
	IF(IT.GT.10)JI=IT-10
	IF(IS)JI=JI+5
	CALL FILLER(A,B,IB,JI,IS,IT,LD,LS)
	GO TO 702
708	IF(IS)GO TO 341
	GO TO 689
608	NV=-1
	IF(LV.EQ.0)NV=1
	CALL IPAK(JX,JY,MN,NV,NZ)
	NX=JX
	NY=JY
	GO TO 341
306	NY=LY
	GO TO 308
307	NX=LX
	GO TO 308
230	IF(N.EQ.' ')GO TO 258
231	IF(N.LT.'1'.OR.N.GT.'4')GO TO 255
	REREAD 408,M,N
408	FORMAT(A1,I1)
	IF(M.EQ.'S')GO TO 278
   	IF(M.NE.'I')GO TO 256
257	KP(N)='     '
	CALL HYDPOG(N)
	IF(M.EQ.'P')GO TO 259
	GO TO 360
255	IF(M.EQ.'P')GO TO 259
258	IF(M.EQ.'S')GO TO 341
	N=NP
	GO TO 257
256	NP=N
	GO TO 251
261	IF(NS)GO TO 211
	NS=-1
	IF(LV.EQ.1)GO TO 666
	JX=NX
	JY=NY
	GO TO 301
666	JX=LX
	JY=LY
	GO TO 192
580	IF(IP)GO TO 581
	IP=-1
	GO TO 360
581	IP=0
	N=5
	GO TO 257
500	IF(NZ.EQ.20)GO TO 503
	NZ=NZ+1
	GO TO 503
501	IF(NZ.EQ.5)GO TO 503
	NZ=NZ-1
	GO TO 503
502	IF(NZ.EQ.10)GO TO 503
	NZ=10
503	CALL CLRPOG(NP)
	CALL IDRA(MN,NZ)
335	NS=0
	GO TO 341
510	REREAD 516,MO,NAM
516	FORMAT(1XA1,A5)
	IF(MO.EQ.'G')GO TO 778
	IF(.NOT.LOOKD(NAM))GO TO 260
	GO TO 515
778	CALL GETFIL(NAM)
	CALL FASTIN(IB,2)
	MS=IB(2)
	CALL GETFIL(NAM)
	CALL FASTIN(IB,MS+2)
	CALL GETP(IB,NN(MN+1))
	DO 777 K=MN+1,MN+MS
	I=NP*100000000
	IF(NN(K))I=-I	
777	NN(K)=NN(K)+I	
	MN=MN+MS
	GO TO 503
340	CALL CLRPOG(NP)
	J=0
400	J=J+1
507	IF(J.GT.MN)GO TO 466
	MP=MOD(IMP(J),10)
	IF(MP.NE.NP)GO TO 400
	DO 401 I=J,MN-1
401	NN(I)=NN(I+1)
	MN=MN-1
	GO TO 507
466	IF(JE)GO TO 467
	IP=-1
	GO TO 431
105	LP=MOD(IMP(MN),10)
	IF(MN.LT.1.OR.LP.NE.NP)GO TO 335
	IF(NP.EQ.1)II(2)=II(2)-1
	IF(NP.EQ.2)JJ(2)=JJ(2)-1
	IF(NP.EQ.3)KK(2)=KK(2)-1
	IF(NP.EQ.4)LL(2)=LL(2)-1
        CALL ACCPOG(NP)
	MN=MN-1
	LV=0
	IF(NN(MN))LV=1
	GO TO 341
150	NC=-1
	IF(LV.NE.1)GO TO 301
191	R=0
	MN=MN-1
	RM=(NX-LX)**2+(NY-LY)**2
	RM=SQRT(RM)
	KX=LX+RM*SIND(R)
	KY=LY+RM*COSD(R)
	CALL IPAK(KX,KY,MN,1,NZ)
	DO 151 K=6,360,6
	R=K
	KX=LX+RM*SIND(R)
	KY=LY+RM*COSD(R)
151	CALL IPAK(KX,KY,MN,-1,NZ)
	GO TO 333
380	IF(LV.NE.1)GO TO 103
	REREAD 377,M,N
377	FORMAT(A1,I2)
	IF(N.LT.4)N=100
	KN=N/10
	IF(KN.LT.2)KN=2
	DO 381 I=0,N,KN
	CALL IPAK(LX-N/2+I,LY-N/2+I,MN,1,NZ)
381	CALL IPAK(NX-N/2+I,NY-N/2+I,MN,-1,NZ)
	GO TO 341
799	LX=NX*10/NZ
	LY=NY*10/NZ
	I=MN
	NY=1000
	DO 801 K=1,MN
	CALL INXY(JX,JY,K)
	NX=IABS(JX-LX)+IABS(JY-LY)
	IF(NY.LT.NX)GO TO 801
	I=K
	NY=NX
801	CONTINUE
	LF=0
	MP=NP
	IN=1
	GO TO 548
813	IN=-1
	I=MN+1
	GO TO 426
425	I=0
	MP=NP
	IF(N.EQ.'E')GO TO 813
	IN=1
426	I=I+IN
784	IF(I.GT.MN.OR.I.LT.1)GO TO 804
548	CALL INXY(NX,NY,I)
	CALL SETCUR(NX*NZ/10,NY*NZ/10,1)
794	IF(IN)TYPE 815
815	FORMAT(' -'/)
	TYPE 469
469	FORMAT(' EDIT?'$)
	ACCEPT 103,M,N
	IF(M.EQ.' ')GO TO 426
	IF(M.EQ.'-')GO TO 810
	IF(M.EQ.'+')GO TO 783
	IF(M.EQ.'D')GO TO 470
	IF(M.EQ.'I')GO TO 547
	IF(M.EQ.'O')GO TO 782
	IF(M.EQ.'C')GO TO 800
	IF(M.EQ.':')GO TO 790
	IF(M.EQ.')')GO TO 900
	CALL RDCUR(NX,NY)
	IF(M.EQ.'M')GO TO 780
	IF(M.NE.'B')GO TO 804
	I=I-IN
	GO TO 548
804	NP=MP
	GO TO 211
810	IN=-IN
	GO TO 426
900	IF(IN)GO TO 901
	IM=I
	NF=LF
	GO TO 794
901	IM=LF
	NF=I
	GO TO 794
800	IF(LF.EQ.0.OR.LF.GT.MN)LF=I
	NP=MP
	DO 806 K=LF,I,IN
	CALL INXY(NX,NY,K)
	JF=IMP(K)/10
	MS=1
	IF(NN(K))MS=-1
806	CALL IPAK(NX,NY,MN,MS,10)
814	JF=0
	LF=0
	GO TO 471
790	LF=I
	GO TO 794
780	JF=IMP(I)/10
	LF=I
	NX=NX*10/NZ
	NY=NY*10/NZ
	GO TO 786
783	REREAD 377,M,N
	I=I+IN*N
	GO TO 784
782	REREAD 377,M,JF
	IF(JF.OR.JF.EQ.10.OR.JF.GT.19)JF=0
	IF(LF.EQ.0.OR.LF.GT.MN)LF=I
796	CALL INXY(NX,NY,LF)
786	MS=1
	IF(NN(LF))MS=-1
	NP=MOD(IMP(LF),10)
	LF=LF-1
	CALL IPAK(NX,NY,LF,MS,10)
	LF=LF+IN
	IF(IN.AND.(LF-I))GO TO 814
	IF(.NOT.IN.AND.(I-LF))GO TO 814
	GO TO 796
547	NN(I)=-NN(I)
	GO TO 471
470	MN=MN-1
	DO 428 K=I,MN
428	NN(K)=NN(K+1)
471	CALL CLRPOG(NP)
	CALL IDRA(MN,NZ)
	CALL DPYOUT(NP)
	GO TO 784
431	NX=0
	NY=0
	NF=MN+1
	IM=0
	GO TO 211
432	IF(IM.EQ.0)IM=MN
	DO 433 I=NF,IM
	JF=IMP(I)/10
	CALL INXY(IX,IY,I)
	IX=NX+IX
	IY=NY+IY
	MP=1
	IF(NN(I))MP=-1
433	CALL IPAK(IX,IY,MN,MP,NZ)
	JF=0
	GO TO 341

104	CALL CLRCUR
	CALL IPOG(NZ)
	IP=-1
   	TYPE 111
111	FORMAT(' TYPE:<CR>;TO CONTINUE.'/' TYPE:''N''<CR>;TO START OVER.'/
	2' TYPE:''X'' TO SAVE VIS POGS IF FINISHED'/
	3' OR TYPE:''P'' TO PLOT ALL VIS POGS'/)
	ACCEPT 103,M,NV
	IF(M.EQ.'N')GO TO 1
	IF(M.EQ.'P')GO TO 557
	IF(M.NE.'X')GO TO 120
127	TYPE 121
121	FORMAT(' TYPE A FIVE LETTER NAME FOR THIS PICTURE.'/)
	ACCEPT 3,NAM
	IF(NAM.EQ.'     ')GO TO 127
557	MP=0
	DO 405 IK=1,4
	IF(KP(IK).NE.'VIS  ')GO TO 405
	MP=MP+1
405	CONTINUE
	IF(MP.EQ.0)GO TO 104
	IF(M.EQ.'P')GO TO 555
	NP=0
	JE=-1
467	NP=NP+1
	IF(NP.GT.4)GO TO 468
	IF(KP(NP).NE.'VIS  ')GO TO 340
	GO TO 467
468	CALL OFILE(1,NAM)
	WRITE(1)MN,(NN(K),K=1,MN)
	END FILE 1
	GO TO 1
555	TYPE 587
587	FORMAT(/' PLOTING CURRENT POG'/)
	CALL PLOTS(I)
	IF(NV.EQ.'L')GO TO 797
	IF(NV.EQ.'S')GO TO 850
	IF(NV.NE.'D'.AND.NV.NE.'B')GO TO 851
	LD=-1
850	LS=-1
851	IS=0
	GO TO 601
689	IF(NV.EQ.'S'.OR.NV.EQ.'D'.OR.NV.EQ.'Z')GO TO 711
797	DO 556 I=1,MN
	IF(MOD(IMP(I),10).NE.NP)GO TO 556
	CALL INXY(NX,NY,I)
	MO=3
	IF(NN(I))MO=2
	CALL PLOT(NX*NZ/10,NY*NZ/10,MO)
556	CONTINUE
711	CALL PLOT(0,0,3)
	TYPE 691
691	FORMAT(' FINISHED PLOTING!'/)
	IS=-1
	LS=0
	LD=0
	GO TO 211
	END

	SUBROUTINE IPOG(NZ)
	COMMON KP(5),NP,NN(4096),JF
	DIMENSION MM(24),JP(4)
	CALL DPYSET(5,MM,24)
	CALL DPYTXT(100,-430,'POG1 POG2 POG3 POG4 ZOOM ',5)
	KP(5)=' REG '
	IF(NZ.LT.10)KP(5)=' --- '
	IF(NZ.GT.10)KP(5)=' +++ '
	CALL DPYTXT(100,-450,KP,5)
	DO 4 J=1,4
	JP(J)='     '
4	IF(J.EQ.NP)JP(J)=' ↑↑  '
	CALL DPYTXT(100,-470,JP,4)
	CALL DPYOUT(5)
	CALL SETPOG(NP)
	RETURN
	END
	SUBROUTINE IPAK(NX,NY,MN,MP,NZ)
	COMMON KP(5),NP,NN(4096),JF
	MN=MN+1
	IX=(NX*10/NZ)+1024
	IY=(NY*10/NZ)+1024
	NN(MN)=MP*((JF*10+NP)*100000000+IX*10000+IY)
	CALL IPEN(NX,NY,MP,10)
	RETURN
	END
	SUBROUTINE IPEN(NX,NY,MP,NZ)
	IX=NX*NZ/10
	IF(IX.GT.950)IX=950
	IF(IX.LT.-950)IX=-950
	IY=NY*NZ/10
	IF(IY.GT.950)IY=950
	IF(IY.LT.-950)IY=-950
	IF(MP)GO TO 1
	CALL AIVECT(IX,IY)
	RETURN
1	CALL AVECT(IX,IY)
	RETURN
	END
	SUBROUTINE INXY(NX,NY,MN)
	COMMON KP(5),NP,NN(4096),JF
	J=IABS(NN(MN))
	NY=MOD(J,10000)-1024
	NX=(MOD(J,100000000)/10000)-1024
	RETURN
	END
	SUBROUTINE IDRA(MN,NZ)
	COMMON KP(5),NP,NN(4096),JF
	DO 1 I=1,MN
	KF=MOD(IABS(NN(I)/100000000),10)
	IF(KF.NE.NP)GO TO 1
	CALL INXY(IX,IY,I)
	CALL IPEN(IX,IY,NN(I),NZ)
1	CONTINUE
	RETURN
	END